Main Figure 3-D,G,H
junio 11, 2021
0.1 Introduction
In this Rmarkdown we are going to plot panels D, G & H. In this script we will use the Visium data coming from spatial_analysis/05-sc_mapping/07-sc_mapping_viz.Rmd and the scRNAseq data from sc_analysis/04-annotation/07-join_annotation.Rmd.
0.2 Libraries
library(Seurat)
library(ggpubr)
library(cowplot)
library(dplyr)
library(ggplot2)
library(RColorBrewer)
library(glue)
library(stringr)
library(readr)0.3 Setting parameters
Loading necessary paths and parameters
set.seed(123)
source(here::here("misc/paths.R"))
source(here::here("utils/bin.R"))
"{fig_pt}/{plt_dir}" %>%
glue::glue() %>%
here::here() %>%
dir.create(
path = .,
showWarnings = FALSE,
recursive = TRUE)
"{fig_pt}/{robj_dir}" %>%
glue::glue() %>%
here::here() %>%
dir.create(
path = .,
showWarnings = FALSE,
recursive = TRUE)
SpatialColors <- colorRampPalette(colors = rev(x = brewer.pal(n = 11, name = "Spectral")))0.4 Load data
Load Visum and scRNAseq data
# 07-sc_mapping_viz.Rmd
# se_obj <- "{map_27}/{robj_dir}/se_deconv_{sample_id}_epid20_pre-rotation.rds"
sp_ls <- lapply(id_sp_df$gem_id, function(id) {
se_obj <- "{map_27}/{robj_dir}/se_deconv_{id}_epid20.rds" %>%
glue::glue() %>%
here::here() %>%
readRDS(file = .)
return(se_obj)
})
se_obj <- merge(sp_ls[[1]], y = sp_ls[2:length(sp_ls)],
add.cell.ids = id_sp_df$gem_id,
project = "Gloria-Salva")
# *sc_analysis/04-annotation/07-join_annotation.Rmd
sc_obj <- "{anot_28}/{robj_dir}/harmony_se_annot.rds" %>%
glue::glue() %>%
here::here() %>%
readRDS(file = .)0.5 Panels
0.5.1 Panel D
In this panel we show the UMAP with the all cell identity populations
panel_d <- Seurat::DimPlot(
object = sc_obj,
group.by = c("specific_annot")) +
ggplot2::labs(title = "")
panel_d
"{fig_pt}/{plt_dir}/Main_Figure3-D.pdf" %>%
glue::glue() %>%
here::here() %>%
cowplot::save_plot(
filename = .,
plot = panel_d,
base_height = 8,
base_width = 12)0.5.2 Panel F
In this panel we show genes of interest on the cell identity’s of interest.
mask_remove <- ! sc_obj$specific_annot %in% c("Proliferating Basal Cells",
"Basal Cells", "Erithrocytes")
panel_f <- Seurat::FeaturePlot(
object = sc_obj[, mask_remove],
features = c(
"Apod", # Nerve regeneration
"Nrep", # Nerve regeneration
"Ncam1", # Non-myelinating-Immature Schwann cells
"Vcan", # Extracellular matrix / Perineuronal net constituent
"Has1", # Extracellular matrix / Perineuronal net constituent
"Tnc" # Extracellular matrix / Perineuronal net constituent
),
ncol = 3, pt.size = 0.25) &
ggplot2::scale_color_gradient(
low = "yellow",
high = "red")
panel_f
"{fig_pt}/{plt_dir}/Main_Figure3-F.pdf" %>%
glue::glue() %>%
here::here() %>%
cowplot::save_plot(
filename = .,
plot = panel_f,
base_height = 8,
base_width = 12)0.5.3 Panel G
In this panel we want to show the mouse % along with the predicted proportion of tumour-associated Schwann cells in the Visium slides.
row1 <- Seurat::SpatialPlot(
object = se_obj,
features = c("Tumour-associated Schwann Cells"),
images = c("uzntl1_fkclxp", "k886qc_rqix54","s2yq8o_t5hk8u", "ivuznh_s8xyfv"),
crop = FALSE,
pt.size.factor = 1.25,
image.alpha = 0) &
ggplot2::scale_fill_gradientn(
colours = SpatialColors(n = 100),
limits = c(0, max(se_obj$`Tumour-associated Schwann Cells`)))
row1_mod <- ggpubr::ggarrange(row1[[1]], row1[[2]], row1[[3]], row1[[4]],
ncol = 4, common.legend = TRUE, legend = "right")
row1_mod
row2 <- Seurat::SpatialPlot(
object = se_obj,
features = c("percent.mouse"),
images = c("uzntl1_fkclxp", "k886qc_rqix54","s2yq8o_t5hk8u", "ivuznh_s8xyfv"),
crop = FALSE,
pt.size.factor = 1.25,
image.alpha = 0) &
ggplot2::scale_fill_gradientn(
colours = SpatialColors(n = 100),
limits = c(0, 1))
row2_mod <- ggpubr::ggarrange(row2[[1]], row2[[2]], row2[[3]], row2[[4]],
ncol = 4, common.legend = TRUE, legend = "right")
row2_mod
"{fig_pt}/{plt_dir}/Main_Figure3-G1.pdf" %>%
glue::glue() %>%
here::here() %>%
cowplot::save_plot(
filename = .,
plot = row1_mod,
base_height = 4,
base_width = 16)
"{fig_pt}/{plt_dir}/Main_Figure3-G2.pdf" %>%
glue::glue() %>%
here::here() %>%
cowplot::save_plot(
filename = .,
plot = row2_mod,
base_height = 4,
base_width = 16)0.5.4 Panel H
In this panel we want to show genes of interest in the spatial slides
plt_ls <- lapply(c("GRCh38-CD36", "mm10---Vcan", "mm10---Tnn"), function(feat) {
tmp <- Seurat::SpatialPlot(
object = se_obj,
features = feat,
images = c("uzntl1_fkclxp", "k886qc_rqix54","s2yq8o_t5hk8u", "ivuznh_s8xyfv"),
crop = FALSE,
pt.size.factor = 1.25,
image.alpha = 0) &
ggplot2::scale_fill_gradientn(
colours = SpatialColors(n = 100),
limits = c(0, max(se_obj@assays$Spatial@data[feat, ])))
tmp <- ggpubr::ggarrange(
tmp[[1]], tmp[[2]], tmp[[3]], tmp[[4]],
ncol = 4, common.legend = TRUE, legend = "right")
})
panel_h <- cowplot::plot_grid(
plotlist = plt_ls,
align = "hv",
axis = "trbl",
nrow = 3)
panel_h
"{fig_pt}/{plt_dir}/Main_Figure3-H.pdf" %>%
glue::glue() %>%
here::here() %>%
cowplot::save_plot(
filename = .,
plot = panel_h,
base_height = 12,
base_width = 16)0.6 Session Info
sessionInfo()## R version 4.0.4 (2021-02-15)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04.2 LTS
##
## Matrix products: default
## BLAS: /usr/local/lib/R/lib/libRblas.so
## LAPACK: /usr/local/lib/R/lib/libRlapack.so
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C LC_TIME=es_ES.UTF-8 LC_COLLATE=en_US.UTF-8 LC_MONETARY=es_ES.UTF-8 LC_MESSAGES=en_US.UTF-8 LC_PAPER=es_ES.UTF-8 LC_NAME=C LC_ADDRESS=C LC_TELEPHONE=C LC_MEASUREMENT=es_ES.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] readr_1.4.0 stringr_1.4.0 glue_1.4.2 RColorBrewer_1.1-2 dplyr_1.0.6 cowplot_1.1.1 ggpubr_0.4.0 ggplot2_3.3.3 SeuratObject_4.0.1 Seurat_4.0.2 BiocStyle_2.18.1
##
## loaded via a namespace (and not attached):
## [1] readxl_1.3.1 backports_1.2.1 plyr_1.8.6 igraph_1.2.6 lazyeval_0.2.2 splines_4.0.4 listenv_0.8.0 scattermore_0.7 digest_0.6.27 htmltools_0.5.1.1 magick_2.7.2 fansi_0.4.2 magrittr_2.0.1 tensor_1.5 cluster_2.1.0 ROCR_1.0-11 openxlsx_4.2.3 globals_0.14.0 matrixStats_0.58.0 spatstat.sparse_2.0-0 colorspace_2.0-1 ggrepel_0.9.1 haven_2.4.1 xfun_0.23 crayon_1.4.1 jsonlite_1.7.2 spatstat.data_2.1-0 survival_3.2-7 zoo_1.8-9 polyclip_1.10-0 gtable_0.3.0 leiden_0.3.8 car_3.0-10 future.apply_1.7.0 abind_1.4-5 scales_1.1.1 DBI_1.1.1 rstatix_0.7.0 miniUI_0.1.1.1 Rcpp_1.0.6 viridisLite_0.4.0 xtable_1.8-4 reticulate_1.20 spatstat.core_2.1-2 foreign_0.8-81 htmlwidgets_1.5.3 httr_1.4.2 ellipsis_0.3.2 ica_1.0-2 farver_2.1.0 pkgconfig_2.0.3 sass_0.4.0 uwot_0.1.10 deldir_0.2-10
## [55] utf8_1.2.1 here_1.0.1 labeling_0.4.2 tidyselect_1.1.1 rlang_0.4.11 reshape2_1.4.4 later_1.2.0 munsell_0.5.0 cellranger_1.1.0 tools_4.0.4 cli_2.5.0 generics_0.1.0 broom_0.7.6 ggridges_0.5.3 evaluate_0.14 fastmap_1.1.0 yaml_2.2.1 goftest_1.2-2 knitr_1.33 fitdistrplus_1.1-3 zip_2.1.1 purrr_0.3.4 RANN_2.6.1 pbapply_1.4-3 future_1.21.0 nlme_3.1-152 mime_0.10 compiler_4.0.4 rstudioapi_0.13 plotly_4.9.3 curl_4.3.1 png_0.1-7 ggsignif_0.6.1 spatstat.utils_2.1-0 tibble_3.1.2 bslib_0.2.5.1 stringi_1.6.2 highr_0.9 ps_1.6.0 forcats_0.5.1 lattice_0.20-41 Matrix_1.3-3 vctrs_0.3.8 pillar_1.6.1 lifecycle_1.0.0 BiocManager_1.30.15 spatstat.geom_2.1-0 lmtest_0.9-38 jquerylib_0.1.4 RcppAnnoy_0.0.18 data.table_1.14.0 irlba_2.3.3 httpuv_1.6.1 patchwork_1.1.1
## [109] R6_2.5.0 bookdown_0.22 promises_1.2.0.1 KernSmooth_2.23-18 gridExtra_2.3 rio_0.5.26 parallelly_1.25.0 codetools_0.2-18 MASS_7.3-53 assertthat_0.2.1 rprojroot_2.0.2 withr_2.4.2 sctransform_0.3.2 mgcv_1.8-33 parallel_4.0.4 hms_1.1.0 grid_4.0.4 rpart_4.1-15 tidyr_1.1.3 rmarkdown_2.8 carData_3.0-4 Rtsne_0.15 shiny_1.6.0